home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PSTUI100
/
PTUI.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-16
|
13KB
|
379 lines
{
╔══════════════════╗
║ Text User ║
║ Interface ║
║ Rev. 1.00 ║
╚══════════════════╝
}
Unit PTUI;
{$F+} {$O-} {$A+} {$G+}
{$V-} {$B-} {$X-} {$N+} {$E+}
{$I FINAL.PAS}
{$IFDEF FINAL}
{$I-} {$R-}
{$D-} {$L-} {$S-}
{$ENDIF}
Interface
Uses CRT,Strings,PTUIMDef,PTUIMSE,PTUIVMSE,PTUIVCRT,KeyDef;
Const
MouseLeftButton = 0;
MouseRightButton = 1;
MouseMiddleButton= 2;
MouseGranularity = 8;
SpecialNIL = Ptr($FFFF,$FFFF);
Type
LineStyles = (DoubleLine,SingleLine,NoLine);
ShadowStyles = (LightHash,MediumHash,DarkHash,Solid,NoShade);
HideOrShow = (Hidden,Visible);
SlideBarInfo = Record
X1,Y1,X2,Y2 :Word;
Forg :Word;
Back :Word;
MainChar :Char;
ButtonChar :Char;
UpLeftChar :Char;
DownRightChar :Char;
CurPos :LongInt;
MaxPos :LongInt;
ButtonScreenPos :Word;
ButtonNum :Word;
BarButtonNum :Word;
ButtonLeftUpNum :Word;
ButtonRightDownNum :Word;
End;
ButtonListPtr = ^ButtonList; {Buttons to click on}
ButtonList = Record
X1,Y1,X2,Y2:Word; {Screen Co-ordinate}
Special :Boolean; {Keyboard Keys}
Key :Char; {Keyboard Character}
Number :Word; {It's own Unique Number}
Next :ButtonListPtr; {Next Button in Linked List}
End;
ButtonChain = Object
Total :Word;
Procedure Init;
Function Position :Word;
Function Number :Word;
Procedure GotoPosition (Here:Word);
Procedure GotoNumber (ButtonNumber:Word);
Procedure Add (X1, Y1, X2, Y2:Word;
Special:Boolean; Key:Char);
Procedure Move (X, Y:Integer;
ButtonNumber:Word);
Procedure MoveAll (X, Y:Integer);
Procedure WaitForClick (Var X, Y:Word;Var MouseButtons:Byte;
Var Held,Doubled,Special:Boolean;
Var Key:Char);
Procedure KillAll;
Procedure KillFrom;
Procedure KillOne;
Private
Root :Pointer;
Buttons :ButtonListPtr;
Function NewButtonNumber:Word;
End;
MouseFunctions = Object
Init :MouseProc_Init;
Show :MouseProc_Show;
Hide :MouseProc_Hide;
SetSpeed :MouseProc_SetSpeed;
SetXY :MouseProc_SetXY;
SetBounds :MouseProc_SetBounds;
GetPresses :MouseProc_GetPresses;
GetXY :MouseProc_GetXY;
GetStatus :MouseProc_GetStatus;
GetClick :MouseProc_GetClick;
Function ComputerSpeed:LongInt;
Function Active :Boolean;
End;
TextWindow = Object
VSlide :SlideBarInfo;
HSlide :SlideBarInfo;
HdrButtonNum :Word; {Button Numbers}
Buttons :ButtonChain; {The window's buttons}
Card :MonoOrColor;
Status :HideOrShow; {Visible or Not}
LineStyle :LineStyles; {Box Outline Style}
ShadowStyle :ShadowStyles; {Shadow Style}
ShadowXSize,
ShadowYSize,
BoxFrg, {Forg Colour}
BoxBck, {Back Colour}
ShdFrg, {Shadow Colour}
ShdBck,
HdrFrg, {Header Forg}
HdrBck :Byte; {Header Back}
Size, {Memory Required}
X1,Y1, {Location on Screen}
X2,Y2 :Word;
Header :String; {Heading Line}
HdrFmt :TextFormats; {Header Position}
Procedure Open(NX1,NY1,NX2,NY2:Word;Forg,Back,
ShadForg,ShadBack:Byte;
LStyle:LineStyles;SStyle:ShadowStyles);
Procedure DisplayHeading;
Procedure NewHeading(NewHead:String;NewMode:TextFormats;
Forg,Back:Byte);
Procedure Hide;
Procedure Show;
Procedure NewPosition(NewX,NewY:Word);
Procedure Drag;
Procedure DragVertSlideButton;
Procedure DragHorzSlideButton;
Procedure NewSize(NX1,NY1,NX2,NY2:Word);
Procedure NewStyle(Forg,Back,ShadForg,ShadBack:Byte;
LStyle:LineStyles;SStyle:ShadowStyles);
Procedure HeadingIcon (Active:Boolean);
Procedure VertSlideIcon (Active:Boolean);
Procedure DrawVertSlideBar;
Procedure VertSlideBar (Details:SlideBarInfo);
Procedure UpdateVertSlideBar (CurPos:LongInt);
Procedure HorzSlideIcon (Active:Boolean);
Procedure DrawHorzSlideBar;
Procedure HorzSlideBar (Details:SlideBarInfo);
Procedure UpdateHorzSlideBar (CurPos:LongInt);
Procedure HeadingPos (Var BX1,BY1,BX2,BY2:Word);
Procedure VertSlideBarPos (Var BX1,BY1,BX2,BY2:Word);
Procedure VertSlideButtonPos (Var BX1,BY1,BX2,BY2:Word);
Procedure VertSlideButtonUpPos (Var BX1,BY1,BX2,BY2:Word);
Procedure VertSlideButtonDownPos (Var BX1,BY1,BX2,BY2:Word);
Procedure HorzSlideBarPos (Var BX1,BY1,BX2,BY2:Word);
Procedure HorzSlideButtonPos (Var BX1,BY1,BX2,BY2:Word);
Procedure HorzSlideButtonLeftPos (Var BX1,BY1,BX2,BY2:Word);
Procedure HorzSlideButtonRightPos(Var BX1,BY1,BX2,BY2:Word);
Procedure Lock;
Procedure UnLock;
Procedure Close;
Private
Save :Pointer; {Memory Area for background}
Procedure SaveBackground;
Procedure DrawWindow;
End;
Procedure EnableVScreen(VideoSystem:VideoCardTypes);
Procedure DisableVScreen;
Procedure InstallVScreenMouse;
Procedure UnInstallVScreenMouse;
Procedure GotoCard(WhereTo:MonoOrColor);
Procedure DrawOutline (X1,Y1,X2,Y2:Word;LStyle:LineStyles);
Procedure DrawShadow (X1,Y1,X2,Y2:Word;SStyle:ShadowStyles);
Procedure DrawShadowWindow (X1,Y1,X2,Y2:Word;ShadForg,ShadBack:Byte;
LStyle:LineStyles;SStyle:ShadowStyles);
Procedure Barometer (X,Y:Word;MaxLen:Byte;WithMe:Char;
Current,EndPoint:LongInt);
Var
Mouse :MouseFunctions;
Error :Procedure(Num:Byte);
OldExitProc1 :Pointer;
OldExitProc2 :Pointer;
Implementation
Procedure DefaultError(Num:Byte); {Halts with an Error}
Begin
ClrScr;
Case Num Of
1:WriteLn('Out of memory.');
End;
Halt(Num);
End;
Procedure EnableVScreen(VideoSystem:VideoCardTypes);
Begin
If VideoSystem in [VGA,BWVGA,SVGA] Then
VideoCard[ColorCard].CharacterLength:=9
Else
If VideoSystem<>SVGA Then
VideoCard[ColorCard].CharacterLength:=8;
VideoCard[ColorCard].CardType:=VideoSystem;
OldExitProc2:=ExitProc;
ExitProc:=@DisableVScreen;
End;
Procedure DisableVScreen;
Begin
If OldExitProc2=SpecialNIL Then Exit;
ExitProc:=OldExitProc2;
OldExitProc2:=SpecialNIL;
SetVirtualScreen(VideoCard[ColorCard].SX2 - VideoCard[ColorCard].SX1 + 1,
VideoCard[ColorCard].SY2 - VideoCard[ColorCard].SY1 + 1);
ScreenOrigin(0,0);
End;
Procedure InstallVScreenMouse;
Var
P,Q :Pointer;
Begin
If Not Mouse.Active Then Exit;
MouseHideCount :=254;
P :=@PTUIVMSE.ControlVScreenMouse;
Asm
les dx, P
mov ax, 0Ch
mov cx, 1
int 33h
End;
OldExitProc1:=ExitProc;
ExitProc:=@UnInstallVScreenMouse;
Mouse.Show :=PTUIVMSE.Show;
Mouse.Hide :=PTUIVMSE.Hide;
Mouse.SetXY :=PTUIVMSE.SetXY;
Mouse.SetBounds :=PTUIVMSE.SetBounds;
Mouse.SetBounds(0,0,(VideoCard[Card].XSize - 1) * MouseGranularity,(VideoCard[Card].YSize - 1) * MouseGranularity);
Mouse.SetXY(0,0);
End;
Procedure UnInstallVScreenMouse;
Begin
If (Not Mouse.Active) Or (OldExitProc1=SpecialNIL) Then Exit;
ExitProc:=OldExitProc1;
OldExitProc1:=SpecialNIL;
Asm
mov ax, 0Ch
mov cx, 0
int 33h
End;
Mouse.Show :=PTUIMSE.Show;
Mouse.Hide :=PTUIMSE.Hide;
Mouse.SetXY :=PTUIMSE.SetXY;
Mouse.SetBounds :=PTUIMSE.SetBounds;
End;
Procedure GotoCard(WhereTo:MonoOrColor);
Const
MouseSaves :Array[MonoOrColor] Of Pointer = (NIL,NIL);
Var
Size :Word;
P :Pointer;
Begin
If Card=WhereTo Then Exit;
If Mouse.Active Then
Begin
Mouse.Hide;
If MouseSaves[Card]=NIL Then {Never Switched Before}
Begin
Asm
mov ax, 15h
int 33h
mov Size, bx
End;
System.GetMem(MouseSaves[Card],Size);
End;
P:=MouseSaves[Card]; {Save Driver For Current Card}
Asm
les dx, P
mov ax, 16h
int 33h
End;
If MouseSaves[WhereTo]<>NIL Then {Restore Driver For New Card}
Begin
P:=MouseSaves[WhereTo];
Asm
les dx, P
mov ax, 17h
int 33h
End;
End;
End;
Card:=WhereTo;
If Mouse.Active Then
Begin
Mouse.SetBounds(0,0,(VideoCard[WhereTo].XSize - 1) * MouseGranularity,(VideoCard[WhereTo].YSize - 1) * MouseGranularity);
Mouse.Show;
End;
End;
Function MouseFunctions.ComputerSpeed:LongInt;
Begin
ComputerSpeed:=PTUIMDef.ComputerSpeed;
End;
Function MouseFunctions.Active:Boolean;
Begin
Active:=PTUIMDef.Active;
End;
{$I PTUIWIN.PAS}
{$I PTUIAPP.PAS}
{$I PTUIBUT.PAS}
Begin
Error :=DefaultError;
OldExitProc1 :=SpecialNIL;
OldExitProc2 :=SpecialNIL;
Mouse.Init :=PTUIMSE.Init;
Mouse.Show :=PTUIMSE.Show;
Mouse.Hide :=PTUIMSE.Hide;
Mouse.SetSpeed :=PTUIMSE.SetSpeed;
Mouse.SetXY :=PTUIMSE.SetXY;
Mouse.SetBounds :=PTUIMSE.SetBounds;
Mouse.GetPresses :=PTUIMSE.GetPresses;
Mouse.GetXY :=PTUIMSE.GetXY;
Mouse.GetStatus :=PTUIMSE.GetStatus;
Mouse.GetClick :=PTUIMSE.GetClick;
Mouse.Init(False);
End.
{ Copyright 1993, Michael Gallias }